home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PBLIB1 / PROGS / ENV.PAS < prev    next >
Pascal/Delphi Source File  |  1994-05-03  |  6KB  |  252 lines
  1. (*PAGE*)
  2. PROGRAM ENV;
  3.  
  4. {$M 15000,0,20000}
  5.  
  6. Uses DOS, CRT, PbCRT, PbMISC, PbDATA, PbOBJS, PbPARMS, PbOUT0,
  7.           PbSELECT,PbLJII;
  8.  
  9. {
  10. Description :  Prints envelopes on LJ4
  11.  
  12. Author      : Howard Richoux
  13. Date        : 11/20/93
  14. Last revised: 11/30/93  more config parameters
  15.               1/3/94    1.02 converted to PbOUT0
  16.               2/18/94   1.04 NEW LIBRARIES
  17. Application : IBM PC and compatibles, done in Turbo Pascal 5.0
  18. Status      : Placed in the Public Domain by HNR Software 1/29/94
  19. Published in: none
  20. }
  21.  
  22.  
  23. var S            : string;
  24. var fname        : string[40];
  25.     SetupString  : string[40];
  26.     Ret1, Ret2, Ret3, Ret4   : string[60];
  27.     ReturnFlag   : boolean;
  28.     ManualFlag   : boolean;
  29.     AddressPAD   : integer;
  30.     ReturnPAD    : integer;
  31.     LinesBetween : integer;
  32.     setup1, setup2, setup3 : string;
  33.     printed      : integer;
  34.  
  35. var crtsave      : CRTSaveRec;
  36.  
  37. var addressdir,template   : string[40];
  38.  
  39. {*****************************************************************}
  40.  
  41.  
  42.  
  43. Procedure EnvelopeSetUp;
  44. var i : integer;
  45.     begin
  46.     OUTNoCR(#27+'E');  {RESET}
  47.     if not pDebug then         {for debug, just run regular paper}
  48.          begin
  49.          OUTNoCR(LJIICMD(3));  {Landscape Mode}
  50.          if ManualFlag then OUTNoCR(LJIICMD(8));  {Manual Feed}
  51.          end;
  52.  
  53.     OUTNoCR(#27+'(10U');  {PC-8}
  54.     if setup1 <> '' then OUTNoCR(#27+setup1);
  55.  
  56.     if returnflag then
  57.          begin
  58.          OUTNoCR(#27+'&l6D');  {6 lpi}
  59.          OUT(conststr(' ',returnpad)+Ret1);
  60.          OUT(conststr(' ',returnpad)+Ret2);
  61.          OUT(conststr(' ',returnpad)+Ret3);
  62.          OUT(conststr(' ',returnpad)+Ret4);
  63.          end;
  64.     for i := 1 to linesbetween do OUT('');
  65.     if setup3 <> '' then OUTNoCR(#27+setup3);
  66.     OUTNoCR(#27+'&l4D');  {4 lpi}
  67.     end;
  68.  
  69.  
  70. Procedure ListFile(fname : string);
  71. var line, CurrFName : string;
  72.     done : boolean;
  73.     tx   : TFILE_object;
  74.     begin
  75.     done := false;
  76.     CurrFName := UpCaseStr(fname);
  77.     tx.init(CurrFName,false);
  78.     while tx.fetchnext(line) and not done do
  79.         begin
  80.         OUT(Conststr(' ',AddressPad)+line);
  81.         if keypressed then done := true;
  82.         end;
  83.     tx.done;
  84.     OUTNoCR(#27+'E');  {RESET}
  85.     end;
  86.  
  87.  
  88. Function LocateFile(var fn : string) : boolean;
  89. var i :integer;
  90.     found : boolean;
  91.     begin
  92.     found := true;
  93.     if      FileExists(addressdir+fn + '.adr') then
  94.          fn := addressdir+fn + '.adr'
  95.     else if FileExists(addressdir+fn)          then
  96.          begin end
  97.     else found := false;
  98.     if found then writeln('Locatefile ',addressdir+fn);
  99.     LocateFile := found;
  100.     end;
  101.  
  102.  
  103. Procedure PrintAddress(fn : string);
  104. var SR :searchrec;
  105.     i  : integer;
  106.     fname : string[80];
  107.     begin
  108.     fname := fn;
  109.     i := Pos('.',fname);
  110.     if LocateFile(fname) then
  111.          begin
  112.          EnvelopeSetUp;
  113.          ListFile(fname);
  114.          inc(printed);
  115.          end
  116.     else writeln('PrintAddress - File Not Found - [',fname,']');
  117.     end;
  118.  
  119.  
  120. (*PAGE*)
  121.  
  122. Procedure Getfiles( Template : string; var fl : STRA_object);
  123. var SR : searchrec;
  124.     ok : boolean;
  125.      begin
  126.      FindFirst(Template,0,SR);
  127.      while DOSError = 0 do
  128.           begin
  129.           if length(sr.name) > 4 then
  130.               begin
  131.               ok := fl.append(sr.name);
  132.               end;
  133.           FindNext(SR);
  134.           end;
  135.      fl.sort;
  136.      end;
  137.  
  138.  
  139. Procedure DoView(dir,template : string);
  140. var filename   : string[40];
  141.     cmd        : string[40];
  142.     itemselect : integer;
  143. var files      : STRA_object;
  144.      begin
  145.      itemselect := 1;
  146.   {   HelpMaxLines := 1000;   }
  147.      filename   := '';
  148.      cmd        := '?RESELECT';
  149.      files.init(100);
  150.      Getfiles(addressdir+Template, files);
  151.      while itemselect > 0 do
  152.           begin
  153.           SetSelectwindow(2,2,18,3,15);
  154.           SetSelectWindowLabels(' ENV - Envelope Printer ',' Select a File ');
  155.           Select(files,filename,itemselect,cmd);
  156.           if (filename <> '') then
  157.               begin
  158.               if printed > 0 then OUTDoneWithPage;
  159.               EnvelopeSetUp;
  160.               ListFile(addressdir+filename);
  161.              {itemselect := 0;}
  162.               end;
  163.           end;
  164.      files.done;
  165.      end;
  166.  
  167.  
  168.  
  169. (*PAGE*)
  170.  
  171.  
  172. Procedure DoStatus;
  173.     begin
  174.     ListParms(0);
  175.     end;
  176.  
  177.  
  178. Procedure Init;
  179.     begin
  180.     printed := 0;
  181.     AddParm(1,'PATH','c:\address\');
  182.     template := '*.adr';
  183.     addparm(1,'ADDRESSPAD','60');
  184.     addparm(1,'RETURNPAD','5');
  185.     addparm(1,'BETWEEN','9');
  186.     addparm(1,'SETUP1','');
  187.     addparm(1,'SETUP2','');
  188.     addparm(1,'SETUP3','');
  189.     addparm(1,'RET1','');
  190.     addparm(1,'RET2','');
  191.     addparm(1,'RET3','');
  192.     addparm(1,'RET4','');
  193.     addparm(1,'MANUAL','YES');
  194.  
  195.     StandardOUTInit;
  196.     OUTSetCompressed;
  197.     OUTSetLandscape;
  198.     OUTSetLengths(200,58);   { Manual override }
  199.  
  200.     addressdir   := GetParmStr('PATH');
  201.     addresspad   := GetParmNum('ADDRESSPAD');
  202.     returnpad    := GetParmNum('RETURNPAD');
  203.     LinesBetween := GetParmNum('BETWEEN');
  204.  
  205.     setup1       := GetParmStr('SETUP1');
  206.     setup2       := GetParmStr('SETUP2');
  207.     setup3       := GetParmStr('SETUP3');
  208.  
  209.     Ret1         := GetParmStr('RET1');
  210.     Ret2         := GetParmStr('RET2');
  211.     Ret3         := GetParmStr('RET3');
  212.     Ret4         := GetParmStr('RET4');
  213.     ReturnFlag   := CheckOK('RETURN');
  214.     ManualFlag   := CheckOK('MANUAL');
  215.  
  216.     if returnflag and (ret1 <> '') then dec(linesbetween);
  217.     if returnflag and (ret2 <> '') then dec(linesbetween);
  218.     if returnflag and (ret3 <> '') then dec(linesbetween);
  219.     if returnflag and (ret4 <> '') then dec(linesbetween);
  220.     end;
  221.  
  222.  
  223. (*  Main program *)
  224.     BEGIN
  225.     pProgID := 'ENV 1.04';
  226.     writeln(pProgID,' - Utility to address envelopes - 11/93 ');
  227.     SaveCRT(CRTSave);
  228.     Init;
  229.  
  230.     fname := 'x';
  231.     if ParamCount > 0 then
  232.          begin
  233.          fname := UpCaseStr(paramstr(1));
  234.          if      fname = 'HELP'   then ShowDocFile
  235.          else if fname = 'STATUS' then DoStatus
  236.          else
  237.               begin
  238.               PrintAddress(fname);
  239.               end;
  240.          end
  241.     else
  242.          begin
  243.          if template <> '' then DoView(addressdir,template)
  244.          else writeln('template = ',template,'   dir = ',addressdir);
  245.          end;
  246.     writeln('');
  247.     RestoreCRT(CRTSave);
  248.   {  OUTdone;  }
  249.     end.
  250.  
  251.  
  252.